2/*********************************************************************************************************************************
    3This file represents the event decription written by the user.
    4
    5Available predicates:
    6-happensAt(E, T) represents a time-point T in which an event E occurs. 
    7-holdsFor(U, L) represents the list L of the maximal intervals in which a U holds. 
    8-holdsAt(U, T) representes a time-point in which U holds. holdsAt may be used only in the body of a rule.
    9-initially(U) expresses the value of U at time 0. 
   10-initiatedAt(U, T) states the conditions in which U is initiated. initiatedAt may be used only in the head of a rule.
   11-terminatedAt(U, T) states the conditions in which U is terminated. terminatedAt may be used only in the head of a rule.
   12
   13For backward compatibility the following predicates are also allowed:
   14
   15-initiates(E, U, T) states that the occurrence of event E at time T initiates a period of time for which U holds. initiates may be used only in the head of a rule.
   16-terminates(E, U, T) states that the occurrence of event E at time T terminates a period of time for which U holds. terminates may be used only in the head of a rule.
   17
   18NOTE:
   19-The optimisation checks in the statically determined fluent definitions are optional.
   20**********************************************************************************************************************************/
   21
   22
   23/*********************************** CTM CE DEFINITIONS *************************************/
   24
   25
   26/****************************************************************
   27 *		     PUNCTUALITY (CHANGE)			*
   28 ****************************************************************/
   29
   30initially(punctuality(_, _)=punctual).
   31
   32initiatedAt(punctuality(Id, VehicleType)=punctual, T) :-
   33	happensAt(stop_enter(Id, VehicleType, _StopCode, scheduled), T).	
   34
   35initiatedAt(punctuality(Id, VehicleType)=punctual, T) :-
   36	happensAt(stop_enter(Id, VehicleType, _StopCode, early), T).	
   37
   38initiatedAt(punctuality(Id, VehicleType)=non_punctual, T) :-
   39	happensAt(stop_enter(Id, VehicleType, _StopCode, late), T).
   40
   41initiatedAt(punctuality(Id, VehicleType)=non_punctual, T) :-
   42	happensAt(stop_leave(Id, VehicleType, _StopCode, early), T).
   43
   44/*
   45% I have commented out this obsolete punctuality definition
   46
   47initiatedAt(punctuality(Id, VehicleType)=punctual, DepartureT) :-
   48	happensAt(stop_enter(Id, VehicleType, StopCode, scheduled), ArrivalT),
   49	happensAt(stop_leave(Id, VehicleType, StopCode, scheduled), DepartureT),
   50	ArrivalT < DepartureT.	
   51
   52initiatedAt(punctuality(Id, VehicleType)=punctual, DepartureT) :-
   53	happensAt(stop_enter(Id, VehicleType, StopCode, early), ArrivalT),
   54	happensAt(stop_leave(Id, VehicleType, StopCode, scheduled), DepartureT),
   55	ArrivalT < DepartureT.	
   56
   57initiatedAt(punctuality(Id, VehicleType)=non_punctual, ArrivalT) :-
   58	happensAt(stop_enter(Id, VehicleType, _, late), ArrivalT).
   59
   60initiatedAt(punctuality(Id, VehicleType)=non_punctual, DepartureT) :-
   61	happensAt(stop_leave(Id, VehicleType, _, early), DepartureT).
   62
   63initiatedAt(punctuality(Id, VehicleType)=non_punctual, DepartureT) :-
   64	happensAt(stop_leave(Id, VehicleType, _, late), DepartureT).
   65*/
   66
   67% it is more efficient to define punctuality=non_punctual as a statically determined fluent as below
   68holdsFor(punctuality(Id, VehicleType)=non_punctual, NPI) :-
   69	holdsFor(punctuality(Id, VehicleType)=punctual, PI),
   70	complement_all([PI], NPI).
   71
   72
   73happensAt(punctuality_change(Id, VehicleType, punctual), T) :-
   74	happensAt(end(punctuality(Id, VehicleType)=non_punctual), T).	
   75
   76happensAt(punctuality_change(Id, VehicleType, non_punctual), T) :-
   77	happensAt(end(punctuality(Id, VehicleType)=punctual), T).	
   78
   79
   80/****************************************************************
   81*		     DRIVING STYLE				*
   82****************************************************************/
   83
   84holdsFor(driving_style(Id, VehicleType)=unsafe, UDI) :-
   85	holdsFor(sharp_turn(Id, VehicleType)=very_sharp, VSTI),
   86	holdsFor(abrupt_acceleration(Id, VehicleType)=very_abrupt, VAAI),
   87	holdsFor(abrupt_deceleration(Id, VehicleType)=very_abrupt, VADI),
   88	union_all([VSTI, VAAI, VADI], UDI).
   89
   90holdsFor(driving_style(Id, VehicleType)=uncomfortable, UDI) :-
   91	holdsFor(sharp_turn(Id, VehicleType)=sharp, STI),
   92	% The three conditions below consider the possibility that very abrupt acceleration 
   93	% or very abrupt deceleration may take place during a sharp turn.
   94	% In this case we should remove, as we do in the three lines below, the intervals 
   95	% in which a very abrupt acceleration/deceleration takes place from the intervals
   96	% in which a sharp turn takes place. Remember: very abrupt acceleration/deceleration
   97	% should lead to unsafe_driving not uncomfortable driving.
   98	% 'uncomfortable_driving' should be read as uncomfortable but safe driving
   99	holdsFor(abrupt_acceleration(Id, VehicleType)=very_abrupt, VAAI),
  100	holdsFor(abrupt_deceleration(Id, VehicleType)=very_abrupt, VADI),  
  101	relative_complement_all(STI, [VAAI, VADI], PureSharpTurn),
  102	holdsFor(abrupt_acceleration(Id, VehicleType)=abrupt, AAI),
  103	holdsFor(abrupt_deceleration(Id, VehicleType)=abrupt, ADI),
  104	union_all([PureSharpTurn, AAI, ADI], UDI).
  105
  106
  107/****************************************************************
  108*		     DRIVING QUALITY				*
  109****************************************************************/
  110
  111holdsFor(driving_quality(Id, VehicleType)=high, HQDI) :- 
  112	holdsFor(punctuality(Id, VehicleType)=punctual, PunctualI),
  113	holdsFor(driving_style(Id, VehicleType)=unsafe, USI),
  114	holdsFor(driving_style(Id, VehicleType)=uncomfortable, UCI),
  115	relative_complement_all(PunctualI, [USI, UCI], HQDI).
  116
  117holdsFor(driving_quality(Id, VehicleType)=medium, MQDI) :- 
  118	holdsFor(punctuality(Id, VehicleType)=punctual, PunctualI),
  119	% optional optimisation check
  120	\+ PunctualI=[], !,
  121	holdsFor(driving_style(Id, VehicleType)=uncomfortable, UCI), 
  122	intersect_all([PunctualI, UCI], MQDI).
  123
  124% the rule below is the result of the above optimisation check
  125holdsFor(driving_quality(Id, VehicleType)=medium, []).
  126
  127holdsFor(driving_quality(Id, VehicleType)=low, LQDI) :- 
  128	holdsFor(punctuality(Id, VehicleType)=non_punctual, NPI),
  129	holdsFor(driving_style(Id, VehicleType)=unsafe, USI),  
  130	union_all([NPI, USI], LQDI).
  131
  132/****************************************************************
  133*		     PASSENGER COMFORT				*
  134****************************************************************/
  135
  136holdsFor(passenger_comfort(Id, VehicleType)=reducing, RPCI) :- 
  137	holdsFor(driving_style(Id, VehicleType)=uncomfortable, UCI),
  138	holdsFor(driving_style(Id, VehicleType)=unsafe, USI),
  139	holdsFor(passenger_density(Id, VehicleType)=high, HPDI),
  140	holdsFor(noise_level(Id, VehicleType)=high, HNLI),
  141	holdsFor(internal_temperature(Id, VehicleType)=very_warm, VWITI),
  142	holdsFor(internal_temperature(Id, VehicleType)=very_cold, VCITI),
  143	union_all([UCI, USI, HPDI, HNLI, VWITI, VCITI], RPCI).
  144
  145
  146initially(passenger_density(_, _)=low).
  147initiates(passenger_density_change(Id, VehicleType, Value), passenger_density(Id, VehicleType)=Value, _T).
  148
  149initially(noise_level(_, _)=low).
  150initiates(noise_level_change(Id, VehicleType, Value), noise_level(Id, VehicleType)=Value, _T).
  151
  152initially(internal_temperature(_, _)=normal).
  153initiates(internal_temperature_change(Id, VehicleType, Value), internal_temperature(Id, VehicleType)=Value, _T).
  154
  155/****************************************************************
  156*		     DRIVER COMFORT				*
  157****************************************************************/
  158
  159holdsFor(driver_comfort(Id, VehicleType)=reducing, RPCI) :- 
  160	holdsFor(driving_style(Id, VehicleType)=uncomfortable, UCI),
  161	holdsFor(driving_style(Id, VehicleType)=unsafe, USI),
  162	holdsFor(noise_level(Id, VehicleType)=high, HNLI),
  163	holdsFor(internal_temperature(Id, VehicleType)=very_warm, VWITI),
  164	holdsFor(internal_temperature(Id, VehicleType)=very_cold, VCITI),
  165	union_all([UCI, USI, HNLI, VWITI, VCITI], RPCI).
  166
  167/****************************************************************
  168*		     PASSENGER SATISFACTION			*
  169****************************************************************/
  170
  171holdsFor(passenger_satisfaction(Id, VehicleType)=reducing, RPSI) :-
  172	holdsFor(punctuality(Id, VehicleType)=non_punctual, NPI),
  173	holdsFor(passenger_comfort(Id, VehicleType)=reducing, RPCI),
  174	union_all([NPI, RPCI], RPSI)